home *** CD-ROM | disk | FTP | other *** search
/ Amiga Magazin: Amiga-CD 1997 November & December / Amiga-CD 1997 #11-12.iso / pd-disketten / dms-gepackt / 5_96 / apd-5-96-2.dms / apd-5-96-2.adf / Amiga-E-Kurs / Listing_2.e < prev    next >
Text File  |  1996-04-15  |  3KB  |  113 lines
  1. /* Vergleich von Sortieralgos, ©1995 M. Bennicke */
  2.  
  3. MODULE '*listing_1',   -> Pfad & Name evtl. anpassen
  4.        'intuition/intuition','intuition/screens',
  5.        'graphics/modeid','dos/dos'
  6.  
  7. CONST ANZ = 1000  -> Anzahl der Feldelemente
  8.  
  9. RAISE "SCR" IF OpenS()=NIL, -> Auto-Exception für
  10.       "WIN" IF OpenW()=NIL  -> OpenW/S() global def.
  11.  
  12. DEF daten[ANZ]:ARRAY OF LONG     -> Daten-Array
  13.  
  14. PROC main() HANDLE
  15.   DEF scr=NIL,win=NIL:PTR TO window,q1,q2,b1,b2,maxi
  16.       
  17.   scr,win:=schirmOeffnen()
  18.   TextF(20,20,'Sortiert werden jeweils \d Zufalls'+
  19.        'zahlen, wobei sie beim ',ANZ)
  20.   TextF(20,29,'1. Durchlauf in zufälliger '+
  21.       'Reihenfolge gespeichert sind')
  22.   TextF(20,38,'und beim 2. in bereits sortierter.')
  23.   TextF(20,50,'Alle Zeitangaben in 1/50 Sekunden.')
  24.  
  25.   /* die Prozedur wird als "quoted expression" über-
  26.      geben, die beiden Zeiten werden retourniert */
  27.   q1,q2:=messen(`quick(daten,0,ANZ-1),
  28.                 'QuickSort',3,70)
  29.   b1,b2:=messen(`bubble(daten,0,ANZ-1),
  30.                 'BubbleSort',2,160)
  31.  
  32.   /* Im Diagramm ist der längste Balken 500 Pixel
  33.      breit, die anderen werden angepaßt */
  34.   -> Maximalwert aus allen 4 Messungen finden
  35.   maxi:=Max(Max(q1,q2),Max(b1,b2))
  36.   Colour(3)                -> 2 Balken für QuickSort
  37.   RectFill(stdrast,100,72,100+(500*q1/maxi),90)
  38.   RectFill(stdrast,100,110,100+(500*q2/maxi),128)
  39.   Colour(2)                -> 2 Balken für BubbleSort
  40.   RectFill(stdrast,100,162,100+(500*b1/maxi),180)
  41.   RectFill(stdrast,100,200,100+(500*b2/maxi),218)
  42.  
  43.   -> Warten auf Message (kann nur WindowClose sein)
  44.   WaitIMessage(win)
  45.   schirmSchliessen(scr,win)
  46. EXCEPT
  47.   SELECT exception -> im Fehlerfall Meldung ausgeben
  48.   CASE "SCR"
  49.     WriteF('Bildschirm ist nicht zu öffnen!\n')
  50.   CASE "WIN"
  51.     WriteF('Fenster ist nicht zu öffnen!\n')
  52.   ENDSELECT
  53.   schirmSchliessen(scr,win)
  54. ENDPROC
  55.  
  56. PROC zeit(prozedur)     -> stoppt die benötigte Zeit
  57.   DEF d1:datestamp,d2:datestamp,t
  58.  
  59.   -> 1. Zeit nehmen, rechnen, 2. Zeit nehmen
  60.   DateStamp(d1); Eval(prozedur); DateStamp(d2)
  61.   IF d2.minute>d1.minute -> In 1/50 Sekunden
  62.     t:=((d2.minute-d1.minute)*3000)+d2.tick-d1.tick
  63.   ELSE
  64.     t:=d2.tick-d1.tick
  65.   ENDIF
  66. ENDPROC t              -> benötigte Zeit zurückgeben
  67.  
  68. PROC datenAusgeben(titel,y,farbe)
  69.   DEF i
  70.  
  71.   Colour(0)
  72.   RectFill(stdrast,20,y-7,500,y+1)
  73.   Colour(farbe)
  74.   TextF(20,y,'\s',titel)
  75.   FOR i:=0 TO 9 DO TextF(100+(i*40),y,
  76.                    '\r\d[5]',daten[i])
  77. ENDPROC
  78.  
  79. PROC messen(prozedur,titel,farbe,ypos)
  80.   -> führt 2 Messungen durch
  81.   DEF i,t1,t2
  82.  
  83.   Line(100,ypos,100,ypos+60,farbe)
  84.   TextF(10,ypos+33,'\s',titel)
  85.  
  86.   -> vor 1. Durchlauf Array mit Werten füllen
  87.   FOR i:=0 TO ANZ-1 DO daten[i]:=Rnd(ANZ)
  88.   datenAusgeben('davor:',ypos-2,farbe)
  89.   -> Zeit messen und auf Bildschirm ausgeben
  90.   t1:=zeit(prozedur); TextF(10,ypos+9,'Zeit: \d',t1)
  91.  
  92.   -> beim zweiten Mal sind die Daten schon sortiert
  93.   t2:=zeit(prozedur); TextF(10,ypos+57,'Zeit: \d',t2)
  94.   datenAusgeben('danach:',ypos+70,farbe)
  95. ENDPROC t1,t2
  96.  
  97. PROC schirmOeffnen()
  98.   DEF s=NIL:PTR TO screen,w=NIL
  99.  
  100.   s:=OpenS(640,256,2,HIRES_KEY,'Vergleich von '+
  101.        'Sortieralgorithmen  ©1995 Marcel Bennicke',
  102.        [SA_PENS,[-1]:INT,0])
  103.   w:=OpenW(0,s.barheight+1,s.width,
  104.        s.height-s.barheight-1,IDCMP_CLOSEWINDOW,
  105.        WFLG_CLOSEGADGET,'Ausgabefenster',s,15,NIL)
  106.   SetTopaz(8); Colour(1)
  107. ENDPROC s,w
  108.  
  109. PROC schirmSchliessen(s,w)
  110.   CloseW(w)  -> Null-Argumente sind möglich
  111.   CloseS(s)  -> klappt auch wenn nichts offen war
  112. ENDPROC
  113.